structure Expr =
struct

val _ = Compiler.Control.Print.printDepth := 100;

(*=== Grammar definition ===*)
datatype factor = Var of string | Num of int;
datatype term   = Mult of term * factor | Term of factor;
datatype expr   = Plus of expr * term | Expr of term;

(*=== Combinator definitions ===*)
datatype ('i, 'o) options  = None of 'i | Some of 'o;
type     ('i, 'o) strategy = 'i -> ('i, 'o) options;

fun choice s1 s2 t =
  case (s1 t) of
    Some t1 => Some t1
  | None t1 => s2 t1;

fun sequ s1 s2 t =
  case (s1 t) of
    Some t1 => s2 t1
  | None t1  => None t1;

fun id   t = (Some t): ('a, 'a) options;
fun fail t = None t;

fun fix s t =
  case (s t) of
    Some t' => fix s t': ('a,'a) options
  | None _  => Some t;

(*====================================================================================================================*)
structure Sample : sig end =
struct
(*=== Sample rewrite rules ===*)
fun r1 (Expr(Term(Var "a"))) = Some (Expr(Term(Var "b")))
  | r1 t                     = None t;

fun r2 (Expr(Term(Var "b"))) = Some (Expr(Term(Var "c")))
  | r2 t                     = None t;

(*=== Sample strategies ===*)
val r1r2seq    = sequ   r1 r2;
val r1r2choice = choice r1 r2;

(*=== Sample tests ===*)
val testSeq1 = r1r2seq (Expr(Term(Var "a")))
val testSeq2 = r1r2seq (Expr(Term(Var "b")))

val testChoice1 = r1r2choice (Expr(Term(Var "a")))
val testChoice2 = r1r2choice (Expr(Term(Var "b")))
val testChoice3 = r1r2choice (Expr(Term(Var "c")))
end;

(*====================================================================================================================*)
structure Errors : sig end =
struct
(*=== Application errors ===*)
fun addZero  (Plus(Expr(Term(Num 0)), x)) = Some (Expr x)
  | addZero  t                            = None t;
val demoAppError = addZero (Plus(Expr(Term(Var "x")), Term(Num 0)));

fun addZero' (Plus(Expr x, Term(Num 0)))  = Some (Expr x)
  | addZero' t                            = None t;
val addZeroes = choice addZero addZero';

(*=== Sequential composition errors ===*)
fun timesZero  (Mult(Term(Num 0), _)) = Some (Term (Num 0))
  | timesZero  t                      = None t;
fun timesZero' (Mult(_, Num 0))       = Some (Term (Num 0))
  | timesZero' t                      = None t;
val timesZeroes = choice timesZero timesZero';

fun timesOne  (Mult(Term(Num 1), x))  = Some (Term x)
  | timesOne  t                       = None t;
fun timesOne' (Mult(Term x, Num 1))   = Some (Term x)
  | timesOne' t                       = None t;
val timesOnes = choice timesOne timesOne';

val simpTimes   = sequ timesZeroes timesOnes;   (* this always fails  *)
val simpTimes'  = sequ timesOnes timesZeroes;   (* this can succeed   *)
val simpTimes'' = choice timesOnes timesZeroes; (* but this is better *)

(*=== Conditional composition errors ===*)
fun timesToPlus  (Plus(e, Mult(t, Num x))) = Some (Plus(Plus(e, t), Mult(t, Num (x - 1))))
  | timesToPlus  t                         = None t

fun timesToPlus' (Plus(e, Mult(t, Num 2))) = Some (Plus(Plus(e, t), t))
  | timesToPlus' t                         = None t

val timesToPluses  = choice timesToPlus timesToPlus'; (* this is bad *)
val removeTimes    = fix timesToPluses;               (* because this does not terminate *)
(*val demoChoiceError = removeTimes' (Plus(Expr(Term(Var "a")), Mult(Term(Var "x"), Num 2)));*)
val timesToPluses' = choice timesToPlus' timesToPlus;
val removeTimes'   = fix timesToPluses';
end;
(*====================================================================================================================*)

(*====================================================================================================================*)
end;
